home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / driver.em < prev    next >
Lisp/Scheme  |  1992-10-06  |  3KB  |  129 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                           ;;
  3. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  4. ;;                                                                           ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. ;;; Xlisp code to drive an X window
  8.  
  9. (defmodule driver
  10.  
  11.   (standard0 plists semaphores) () ()
  12.  
  13.   (deflocal lock (make-semaphore))
  14.  
  15.   (put 'x-service 'plot 0)
  16.   (put 'x-service 'unplot 1)
  17.   (put 'x-service 'read-pixmap 2)
  18.   (put 'x-service 'clearwin 3)
  19.   (put 'x-service 'redraw 4)
  20.   (put 'x-service 'manage 5)
  21.   (put 'x-service 'move 6)
  22.   (put 'x-service 'plot-string 7)
  23.   (put 'x-service 'unplot-string 8)
  24.  
  25.   (defun xgap (win) (prin " " win))
  26.  
  27.   (defun openwin ()
  28.     (popen "xserver" 'output))
  29.  
  30.   (defun closewin (win)
  31.     (pclose win))
  32.  
  33.   (defun xterpri (win) (newline win))
  34.  
  35.   (defun send-code (win service)
  36.     (prin (get 'x-service service) win)
  37.     (flush win)
  38.     (xgap win))
  39.  
  40.   ;; plot pixmap at x y on window
  41.   (defun plot (win pm x y)
  42.     (open-semaphore lock)
  43.     (send-code win 'plot)
  44.     (prin pm win) (xgap win)
  45.     (prin x win) (xgap win)
  46.     (print y win)
  47.     (flush win)
  48.     (close-semaphore lock))
  49.  
  50.   ;; unplot pixmap at x y on window
  51.   (defun unplot (win pm x y)
  52.     (open-semaphore lock)
  53.     (send-code win 'unplot)
  54.     (prin pm win) (xgap win)
  55.     (prin x win) (xgap win)
  56.     (print y win)
  57.     (flush win)
  58.     (close-semaphore lock))
  59.  
  60.   ;; read a new pixmap
  61.   (defun read-pixmap (win name)
  62.     (open-semaphore lock)
  63.     (send-code win 'read-pixmap)
  64.     (print name win)     ;; without quotes
  65.     (xterpri win)
  66.     (flush win)
  67.     (close-semaphore lock))
  68.  
  69.   ;; clear the window
  70.   (defun clearwin (win)
  71.     (open-semaphore lock)
  72.     (send-code win 'clearwin)
  73.     (xterpri win)
  74.     (flush win)
  75.     (close-semaphore lock))
  76.  
  77.   ;; redraw the window
  78.   (defun redraw (win)
  79.     (open-semaphore lock)
  80.     (send-code win 'redraw)
  81.     (xterpri win)
  82.     (flush win)
  83.     (close-semaphore lock))
  84.  
  85.   ;; get the xserver to manage an object with pixmap pm
  86.   ;; the server remembers the last position and unplots it for you
  87.   ;; when you use move
  88.   (defun manage (win pm)
  89.     (open-semaphore lock)
  90.     (send-code win 'manage)
  91.     (print pm win)
  92.     (flush win)
  93.     (close-semaphore lock))
  94.  
  95.   ;; move a managed object
  96.   (defun move (win obj x y)
  97.     (open-semaphore lock)
  98.     (send-code win 'move)
  99.     (prin obj win) (xgap win)
  100.     (prin x win) (xgap win)
  101.     (print y win)
  102.     (flush win)
  103.     (close-semaphore lock))
  104.  
  105.   ;; plot a string
  106.   (defun plot-string (win x y str)
  107.     (open-semaphore lock)
  108.     (send-code win 'plot-string)
  109.     (prin x win) (xgap win)
  110.     (print y win) (xgap win)
  111.     (print str win) 
  112.     (flush win)
  113.     (close-semaphore lock))
  114.  
  115.   ;; unplot it
  116.   (defun unplot-string (win x y str)
  117.     (open-semaphore lock)
  118.     (send-code win 'unplot-string)
  119.     (prin x win) (xgap win)
  120.     (prin y win) (xgap win)
  121.     (print str win)
  122.     (flush win)
  123.     (close-semaphore lock))
  124.  
  125.   (export plot unplot read-pixmap clearwin 
  126.       redraw manage move plot-string unplot-string)
  127.  
  128. )  
  129.